home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d19 / prokit33.arc / PROKIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-06-27  |  7.6 KB  |  269 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1990 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * ProKit.PAS - demo program for the ProKit system (3-1-89)
  15.  *
  16.  *)
  17.  
  18. {!!!IMPORTANT!!! F5 WON'T WORK WITHOUT THE FOLLOWING LINE}
  19. {$M 8000,14000,14000}  {Stack, minheap, maxheap}
  20. {$S-,R-}
  21. {$L+,D+}
  22.  
  23.  
  24. Program ProKit_demo;
  25.  
  26. {$i prokit.inc}    {include standard 'uses' statement}
  27.  
  28.  
  29.  
  30. (* ---------------------------------------------------------------- *)
  31. procedure display_info;
  32. begin
  33.    Pdispln('$WHITE$');
  34.    pdispln(first_name+', here is your User information:$GREEN$');
  35.    displn('   Current date   = '+system_date+' '+system_time);
  36.    displn('   Full name      = '+username);
  37.    displn('   Phone numbers  = '+user.busphone + ' / ' + user.phone);
  38.    displn('   City           = '+user.city);
  39.    displn('   Security level = '+itoa(userlevel));
  40.    displn('   Baud rate      = '+baudrate);
  41.  
  42.    displn('   Last call date = '+user.date+' '+user.time+
  43.            ', Used = '+itoa(user.lastused)+
  44.            '/'+itoa(pcbsys.prev_used));
  45.  
  46.    displn('   Conference     = '+conf_info.conf_name+' ('+
  47.                   itoa(pcbsys.curconf)+'/'+itoa(user.curconf)+')');
  48.  
  49.    displn('   TimeOn (mins)  = '+itoa(pcbsys.time_on)+
  50.            ', Now = '+itoa(get_mins));
  51.  
  52.    displn('   Minutes left   = '+itoa(minutes_left)+
  53.            ', Used = '+itoa(time_used)+
  54.            ', Last = '+itoa(user.lastused)+
  55.            ', Credit = '+itoa(pcbsys.time_credit)+
  56.            ', Limit = '+itoa(pcbsys.time_limit)+
  57.            ', Added = '+itoa(pcbsys.time_added));
  58.  
  59.    displn('   Event schedule = '+itoa(minutes_before_event)+' minutes');
  60.  
  61.    displn('   Downloads      = '+itoa(user.downloads)+
  62.             ', Total = '+dtok(user.downtotal)+
  63.             ', Today = '+dtok(user.downbytes)+
  64.             ', Allowed = '+wtoa(download_k_allowed)+'k');
  65.  
  66.    displn('   Uploads        = '+itoa(user.uploads)+
  67.             ', Total = '+dtok(user.uptotal)+
  68.             ', Earned = '+wtoa(user.earned_k));
  69.  
  70.    disp  ('   Expert mode    = ');
  71.    if expert then displn('ON') else displn('OFF');
  72.  
  73.    disp  ('   Graphics       = ');
  74.    if graphics then displn('ON') else displn('OFF');
  75.  
  76.    displn('   Packed flags   = '+itoa(user.pcbflags));
  77.    displn('   User.inf ptr   = '+ltoa(user.userinf_ptr));
  78.    displn('   Curconfh       = '+wtoa(user.curconfh));
  79.  
  80.    force_enter;
  81. end;
  82.  
  83.  
  84.  
  85. (* ---------------------------------------------------------------- *)
  86. procedure take_chance;
  87. var
  88.    thinking_of:  anystring;
  89.  
  90. begin
  91.    {think of a number - based on the time of day}
  92.    thinking_of := itoa(random(9));
  93.  
  94.    {check for a stacked response- prompt if not}
  95.    if length(cmdline) = 0 then
  96.    begin
  97.       pdispln('$CYAN$I''m thinking of a number from 0 to 9.   If you guess the');
  98.       displn('number, you will be given an extra 10 minutes online.  If you');
  99.       displn('get it wrong, your time will be reduced by 2 minutes.');
  100.       newline;
  101.       pdisp('$YELLOW$What''s your guess? ');
  102.       get_cmdline;
  103.       newline;
  104.    end;
  105.  
  106.    {get the input and process it}
  107.    get_nextpar;
  108.    if par = thinking_of then
  109.    begin
  110.       pdispln('$GREEN$That''s right!  You get a 10 minute bonus!');
  111.       adjust_time_allowed(10 * 60);
  112.    end
  113.    else
  114.  
  115.    begin
  116.       pdispln('$BLUE$Wrong!  You lose 2 minutes!  I was thinking of '+thinking_of+'.');
  117.       adjust_time_allowed(-120);
  118.    end;
  119.  
  120. end;
  121.  
  122.  
  123.  
  124. (* ---------------------------------------------------------------- *)
  125. procedure test_pattern;
  126. var
  127.    i:     integer;
  128.    start: longint;
  129.  
  130. begin
  131.    flush_com;
  132.    start := lget_ms;
  133.    for i := 1 to 40 do
  134.       displn('(1234567890-abcdefghijklmnopqrstuvwxyz-ABCDEFGHIJKLMNOPQRSTUVWXYZ-0123456789)');
  135.    flush_com;
  136.    displn('Speed = '+ftoa(3160000.0 / int(lget_ms - start),0,1)+' char/sec');
  137. end;
  138.  
  139.  
  140. (* ---------------------------------------------------------------- *)
  141. procedure ansi_demo;
  142. var
  143.    x,y: integer;
  144.  
  145. begin
  146.    if not graphics then
  147.    begin
  148.       displn('You must be in GRAPHICS mode to run this demo.');
  149.       displn('Use the (M) command from the main board.');
  150.       exit;
  151.    end;
  152.  
  153.    pdisp('$GREEN$');
  154.    clear_screen;
  155.  
  156.    for y := 2 to 21 do
  157.    begin
  158.       position(1,y);  dispc('│');
  159.       position(79,y); dispc('│');
  160.    end;
  161.  
  162.    position(2,1);
  163.    for x := 2 to 78 do
  164.       dispc('─');
  165.  
  166.    position(2,22);
  167.    for x := 2 to 78 do
  168.       dispc('─');
  169.  
  170.    position(1,1);   dispc('┌');
  171.    position(79,1);  dispc('┐');
  172.    position(1,22);  dispc('└');
  173.    position(79,22); dispc('┘');
  174.  
  175.    position(30,10);  pdisp('$RED$ P r o   K i t ');
  176.    position(12,12);  pdisp('$YELLOW$ This is only a SMALL sample of what ProKit can do! ');
  177.    position(30,18);  pdisp('$WHITE$Press (Enter): ');
  178.    get_cmdline;
  179.  
  180.    cmdline := '';
  181.    clear_screen;
  182. end;
  183.  
  184.  
  185. (* ---------------------------------------------------------------- *)
  186. procedure menu;
  187. begin
  188.    newline;
  189.    pdispln('$GRAY$ProKit DEMO - Based on ProKit '+version);
  190.    newline;
  191.    display_file('prokit.m');  {uses prokit.mg in graphics mode}
  192.    force_enter;
  193.    newline;
  194.  
  195.    {main command loop}
  196.    repeat
  197.  
  198.       {prompt for input only if there is not a stacked command pending}
  199.       if length(cmdline) = 0 then
  200.       begin
  201.          newline;
  202.          pdispln('$WHITE$Main menu:');
  203.          pdispln('$RED$ (I)  Display system information');
  204.          pdispln('$GREEN$ (C)  Take a chance for more time online');
  205.          pdispln('$MAGENTA$ (T)  Display a test pattern, calculate speed');
  206.          pdispln('$CYAN$ (A)  Ansi graphics demo');
  207.          pdispln('$RED$ (G)  Goodbye, hang up');
  208.          pdispln('$BLUE$ (Q)  Return to PCBoard');
  209.          newline;
  210.  
  211.          repeat
  212.             display_time_left;
  213.             pdisp('$YELLOW$Command? ');
  214.             get_cmdline;              {get cmdline, map to upper case}
  215.             newline;
  216.          until dump_user or (length(cmdline) > 0);
  217.       end;
  218.  
  219.       if dump_user then exit;   {leave menu if carrier lost}
  220.       get_nextpar;              {scan next parameter from cmdline into par}
  221.  
  222.       {process commands}
  223.       case par[1] of
  224.          'I':   display_info;
  225.          'C':   take_chance;
  226.          'T':   test_pattern;
  227.          'A':   ansi_demo;
  228.  
  229.          'G':   begin
  230.                    dump_user := true;
  231.                    option := o_logoff;
  232.                 end;
  233.  
  234.          'Q':   exit;
  235.  
  236.          else   pdispln('$MAGENTA$('+par+') is not allowed!  Try again:');
  237.       end;
  238.  
  239.    until dump_user;
  240.  
  241. end;
  242.  
  243.  
  244. (* ---------------------------------------------------------------- *)
  245.  
  246. begin  {main block}
  247.    init;     {must be first - opens com port, loads setup and user data}
  248.    progname := 'Demo';        {program name on status line}
  249.  
  250.    (* the next 4 statements are optional.  If included, they will
  251.       enlarge your EXE file by about 10K, but they will enable access to
  252.       the CONFINFO file as well as to the caller_count function and
  253.       @NUMCALLS@ macro. *)
  254.  
  255.    load_cnames_file;          {locate or create CONFINFO file}
  256.  
  257.    load_conf(0);              {locate main message file, enables @NUMCALLS@}
  258.    mainfn := conf_info.conf_msgfile;
  259.  
  260.    load_conf(current_conf);   {load current conference into conf_info}
  261.  
  262.    (* perform door functions *)
  263.    display_info;
  264.    menu;                      {insert your code here}
  265.  
  266.    uninit;   {must be last - closes com port and updates database}
  267. end.
  268.  
  269.